home *** CD-ROM | disk | FTP | other *** search
- ⓪ IMPLEMENTATION MODULE Runtime;⓪ (*$Y+,L-,R-,N+,C-,M-*)⓪ ⓪ (**********************************************************************⓪ ⓪,Runtime Support fuer Atari Modula-Compiler V#097⓪ ⓪!30.10.86 Version fuer Atari, mit neuem Stringformat:⓪,CAP, STAS angepasst,⓪,RangeCheck fuer CHR.⓪"1.11.86 STAS fuer Stringlaenge > 32K korrigiert;⓪,Prozeduren zur Coroutinen-Unterstuetzung als Dummy.⓪"3.11.86 CHR und CAP fuer neue Char-Darstellung (mit folgendem SyncByte)⓪!30.11.86 Set-Operationen verkraften ungerade Laengenangaben⓪!19.12.86 TrapCode 7 fuer Zugriff ueber NIL-Pointer definiert⓪!22.01.87 TRAP-Auswertung wieder impl.⓪!04.02.87 STAS: BCS ok2 statt BEQ ok2.⓪!27.02.87 TRAP 15: trp0->trp9; GEM-Alert impl.; DivByZero,TRAPV,Addr- und⓪,Bus-Error abgefangen; Vektor-Restauration per SetTerminateProc;⓪,trp7 (access via NIL-Ptr) raus.⓪!02.03.87 Traps:USP wird gerettet; Scan-Aufruf impl.⓪!19.03.87 Fehlerbehandlung -> GEMError-Modul⓪!09.05.87 TRAP-Nummern geändert⓪!19.06.87 neue Real-Arithmetik⓪!30.06.87 IOTransfer impl.⓪!08.07.87 D7->#1; bei Fehler wird Aufrufer angescanned.⓪!22.07.87 IOTransfer, LISTEN, usw. impl.;⓪!23.07.87 @PRIO impl, IOTransfer kann auch auf Vektoren >= $400 ange-⓪,wendet werden.⓪!11.08.87 abermals D7->#1 in Set-Funktionen (wie kam D7 da wieder hin ??)⓪!29.08.87 @IDIV korrigiert (UNLK u. MOVEM vertauscht)⓪!08.09.87 @IOCA neu⓪!27.10.87 FLOAT und TRUNC auf LONGCARD-Parameter umgestellt⓪!13.11.87 @LSTN decr. IR um Eins⓪!16.12.87 Realvergleiche korrigiert (Null galt als größer als Zahlen⓪-mit negativem Exponenten): RELE, REGE, RELT, REGT⓪!17.12.87 Realvergleiche jetzt hoffentlich ok⓪!16.01.88 @PRIO geht auch im Superv.-Mode⓪!01.04.88 @FPDIV für negativen Divisor korrigiert; @IOCA geht jetzt.⓪!09.04.88 Coroutinen-Anpassung f. 68020.⓪!28.05.88 @RES1 und @RES2 für Procedure Entries (ab Comp 3.6a) verwendet⓪!19.07.88 @SMEM, @RELE, @REGE, @RELT, @REGT zerstören nicht mehr D3/D4.⓪!12.08.88 CAP berücksichtigt auch nicht-deutsche Umlaute.⓪!01.01.88 TRUNC löst Runtime-Error bei neg. Arg. aus⓪!19.01.89 881-Unterstützung von MR (26.8.88) übernommen (Cond: A68881)⓪!15.06.89 Include-File f. Prozessoren⓪!16.06.89 881-Routinen überarbeitet (optimiert, Errors)⓪!04.07.89 @STAS korrigiert - machte bei ungeradem Source-String Mist⓪!19.08.89 Runtime läuft nun gleichzeitg mit 68000 & 68020⓪!30.11.89 Optimierungen in Long-Mul/Div/Mod (LINK verlagert)⓪ ***********************************************************************)⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, WORD;⓪ ⓪ IMPORT SysInfo;⓪ ⓪ FROM SFP004 IMPORT FPUInit, FPUError;⓪ ⓪ CONST⓪ ⓪ (*$I FPU.CNF *)⓪ ⓪(DftSF = $0010;⓪ ⓪ VAR has020: BOOLEAN;⓪ ⓪ (*$? A68881:⓪ CONST⓪(fpstat = $fffa40; (* Response word of MC68881 read *)⓪(fpstatlo= $fffa41;⓪(fpctrl = $fffa42; (* Control word of MC68881 write *)⓪(fpcmd = $fffa4a; (* Command word of MC68881 write *)⓪(fpcond = $fffa4e; (* Condition word of MC68881 write *)⓪(fpop = $fffa50; (* Operand long of MC68881 read/write *)⓪ *)⓪ ⓪ (************** Coroutinen-Unterstuetzung **************)⓪ ⓪ ⓪ PROCEDURE BadReturn; (* RTS aus CoRoutine anmeckern *)⓪"BEGIN⓪$ASSEMBLER⓪(TRAP #6⓪(DC.W -15-$6000 ; kein cont, scan prev⓪$END⓪"END BadReturn;⓪ ⓪ ⓪ (*⓪#Transferdaten beim Usermode:⓪(2 Byte - 0: zeigt Usermode an / 1: Vektor zus. restaurieren⓪(4 Byte - PC⓪(2 Byte - SR⓪(4 Byte - A6⓪(56 Byte - D0-A5⓪ ⓪#Transferdaten beim Supervisormode:⓪(2 Byte - $FFxx, zeigt Supervisormode an⓪(4 Byte - USP⓪(60 Byte - D0-A6⓪(4 Byte - Dummy⓪(2 Byte - SR⓪(4 Byte - PC⓪ *)⓪ ⓪ (* Kennung: Zustand:⓪$0 Normal u. Exc-Rückkehr - Usermode⓪$1 Warten auf Exc - Usermode, Vektor restaurieren⓪$$FF Exc-Rückkehr - Supervisormode⓪ *)⓪ ⓪ PROCEDURE @NEWP ( p:PROC; a:ADDRESS; n:LONGCARD; VAR prc:ADDRESS );⓪"BEGIN⓪$ASSEMBLER⓪(LINK A5,#0⓪(⓪(MOVE.L -(A3),A1 ; 'prc'⓪(MOVE.L -(A3),A0 ; SIZE (workspace)⓪(MOVE.L A0,D1⓪(BCLR #0,D1⓪(MOVE.L -(A3),D0 ; ADR (workspace)⓪(ADDQ.L #1,D0⓪(BCLR #0,D0⓪(ADDA.L D0,A0 ; ENDADR (workspace)⓪(MOVE.L -(A3),D2 ; ADR (procedure)⓪(CMPI.L #90,D1 ; ist workspace groß genug ?⓪(BCC wspOk⓪(⓪(TRAP #6⓪(DC.W -10-$4000 ; 'out of stack'⓪(UNLK A5⓪(RTS⓪(⓪&wspOk:⓪(MOVEM.L A3/A5,-(A7)⓪(⓪(MOVE.L D0,A3⓪(⓪(MOVE.L D2,-(A0) ;Adresse für scan⓪(ADDQ.L #2,(A0) ;scan-Adr etwas vorsetzen⓪(CLR.L -(A0) ;voriges A5⓪(MOVE.L A0,A5 ;für UNLK in backScan()⓪(MOVE.L #BadReturn,-(A0) ;Fehlerbehandlung bei RTS aus Coroutine⓪(⓪(MOVEM.L D0-A5,-(A0) ; Bis auf A3,A5 nur Dummy-Werte⓪(MOVE.L A6,-(A0)⓪(MOVE.W SR,-(A0)⓪(MOVE.L D2,-(A0)⓪(CLR.W -(A0)⓪(⓪(; nun den SP in 'prc' ablegen⓪(MOVE.L A0,(A1)⓪(⓪(MOVEM.L (A7)+,A3/A5⓪(UNLK A5⓪$END⓪"END @NEWP;⓪ ⓪ PROCEDURE @TRAN ( VAR source,dest:ADDRESS ); (* Transfer *)⓪"BEGIN⓪$ASSEMBLER⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß⓪(; kann in beiden Modi ablaufen⓪(⓪(MOVE.L -(A3),A2 ; dest⓪(MOVE.L -(A3),A1 ; source⓪(MOVE SR,D2⓪(⓪(; JSR EnterSupervisorMode⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; ③aktiven Prozeß beenden④⓪(MOVE.L USP,A0⓪(MOVE.L (A0)+,D0 ; Rücksprungadr. hinter TRANSFER⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D2,-(A0)⓪(MOVE.L D0,-(A0)⓪(CLR.W -(A0)⓪(⓪(MOVE.L (A2),D0 ; zuerst retten, falls A1=A2⓪(MOVE.L A0,(A1)⓪(MOVE.L D0,A6⓪(⓪(; ③neuen Prozeß starten④⓪(TST.W (A6)+⓪(BEQ stUsr⓪(BMI stSup⓪(⓪(; starte Usermode, vorher Vektor restaurieren⓪(MOVE.L (A6)+,D0 ; alter Vektor⓪(MOVE.L 4+2+4+4(A6),A0 ; D1: Vektoradr.⓪(MOVE.L D0,(A0)⓪(TST has020⓪(BEQ no20⓪(MOVE #DftSF,-(A7)⓪ no20:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stUsr: ; starte Usermode⓪(TST has020⓪(BEQ no20b⓪(MOVE #DftSF,-(A7)⓪ no20b:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stSup: ; starte Supervisormode⓪(MOVE.L A6,A7⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,USP⓪(MOVEM.L (A7)+,D0-A6⓪(ADDQ.L #4,A7⓪(TST has020⓪(BEQ no20c⓪(MOVE.W (A7),-(A7)⓪(MOVE.L 4(A7),2(A7)⓪(MOVE #DftSF,6(A7)⓪ no20c:⓪(RTE⓪$END⓪"END @TRAN;⓪ ⓪ PROCEDURE @LSTN;⓪"BEGIN⓪$ASSEMBLER⓪(; JSR EnterSupervisorMode⓪(MOVE SR,-(A7)⓪(MOVE SR,D0⓪(ANDI #$0700,D0⓪(BEQ ok⓪(MOVE SR,D0⓪(SUBI #$0100,D0⓪(MOVE D0,SR⓪(NOP⓪(NOP⓪&ok:⓪(MOVE (A7)+,SR⓪(ANDI #$FFFF-$2000,SR ; Back into user mode⓪$END⓪"END @LSTN;⓪ ⓪ PROCEDURE hdlExc;⓪"(* Für IOTRANSFER-Auslösungen per Exception *)⓪"BEGIN⓪$ASSEMBLER⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende⓪(; Prozeß ist immer im Usermode⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(BTST.B #5,4(A7) ; aus welchem mode ?⓪(BNE frSup⓪(⓪(; Entry aus User mode⓪(⓪(; Daten auf den USP retten⓪(MOVE.L A6,-(A7)⓪(MOVE.L USP,A6⓪(MOVEM.L D0-A5,-(A6)⓪(MOVE.L (A7)+,-(A6)⓪(MOVE.L (A7)+,A0 ; ^Transfer-Daten⓪(MOVE (A7)+,-(A6) ; SR⓪(MOVE.L (A7)+,-(A6) ; PC⓪(CLR.W -(A6)⓪(⓪(; A0 zeigt auf:⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A6,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST has020⓪(BEQ no20d⓪(MOVE #DftSF,-(A7)⓪ no20d:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ frSup: ; Entry aus Supervisor mode⓪(⓪(; Daten auf den USP retten⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L USP,A6⓪(MOVE.L A6,-(A7)⓪(ST.B -(A7)⓪(⓪(MOVE.L 2+4+60(A7),A0 ; ^Transfer-Daten⓪(⓪(; A0: (s.o.)⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A7,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST has020⓪(BEQ no20e⓪(MOVE #DftSF,-(A7)⓪ no20e:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪$END⓪"END hdlExc;⓪ ⓪ PROCEDURE hdlCall;⓪"(* Für IOTRANSFER-Auslösungen per JSR *)⓪"BEGIN⓪$ASSEMBLER⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende⓪(; Prozeß ist immer im Usermode⓪(⓪(MOVE.L D1,-(A7)⓪(MOVE SR,D1⓪(BTST #13,D1 ; aus welchem Mode ?⓪(BNE frSup⓪(⓪(; Entry aus User mode⓪(⓪(; JSR EnterSupervisorMode⓪(⓪(;BREAK⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; ③aktiven Prozeß beenden, Daten auf den USP retten⓪(; auf USP stehen noch: D1.L, 2 Byte, ^Dest-Transfer-Daten, PC.L⓪(MOVE.L A0,-(A7)⓪(MOVE.L USP,A0⓪(MOVE.L (A0)+,-(A7) ; D1 retten⓪(MOVE.L (A0)+,-(A7) ; ^Transfer-Daten⓪(MOVE.L (A0)+,-(A7) ; PC retten⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D1,-(A0) ; SR⓪(MOVE.L (A7)+,-(A0) ; PC⓪(MOVE.L (A7)+,14(A0) ; D1 in Transfer-Daten ablegen⓪(MOVE.L (A7)+,A1 ; ^Transfer-Daten⓪(MOVE.L (A7)+,42(A0) ; A0 in Transfer-Daten ablegen⓪(CLR.W -(A0)⓪(⓪(; A1 zeigt auf:⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A1),A2 ; A2: alter dest^⓪(MOVE.L A6,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A1),A3 ; D1: Vektoradr.⓪(LEA 2(A1),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST has020⓪(BEQ no20f⓪(MOVE #DftSF,-(A7)⓪ no20f:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ frSup: ; Entry aus Supervisor mode⓪(⓪(MOVE.L (A7),D1⓪(ADDQ.L #2,A7⓪(MOVE.L 2(A7),(A7) ; ^Transfer-Daten 2 Byte tiefer⓪(MOVE SR,4(A7) ; SR darüber⓪(⓪(;BREAK⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; ③aktiven Prozeß beenden, Daten auf den USP retten⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L USP,A0⓪(MOVE.L A0,-(A7)⓪(ST.B -(A7)⓪(⓪(MOVE.L 2+4+60(A7),A0 ; ^Transfer-Daten⓪(⓪(; A0: (s.o.)⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A7,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST has020⓪(BEQ no20g⓪(MOVE #DftSF,-(A7)⓪ no20g:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪$END⓪"END hdlCall;⓪ ⓪ ⓪ PROCEDURE @IOTR ( VAR source,dest:ADDRESS; vecAddr:ADDRESS );⓪"CONST JSRInstr = $4EB9;⓪"BEGIN⓪$ASSEMBLER⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß⓪(; kann in beiden Modi ablaufen⓪(⓪(MOVE.L -(A3),D1 ; vector⓪(MOVE.L -(A3),A2 ; dest⓪(MOVE.L -(A3),A1 ; source⓪(MOVE SR,D2⓪(⓪(; JSR EnterSupervisorMode⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; Daten für 'hdlExc' und 'hdlCall':⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(; ③aktiven Prozeß beenden④⓪(MOVE.L USP,A0⓪(MOVE.L (A0)+,D0 ; Rücksprungadr. hinter IOTRANSFER⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D2,-(A0)⓪(MOVE.L D0,-(A0)⓪(⓪(MOVE.L D1,A3⓪(MOVE.L (A3),-(A0) ; alten vektor retten⓪(⓪(MOVE #1,-(A0)⓪(⓪(MOVE.L (A2),D0 ; zuerst retten, falls A1=A2⓪(MOVE.L A0,(A1)⓪(MOVE.L D0,A6⓪(⓪(CMPA.W #$400,A3⓪(BCS isExc⓪(MOVE.L #hdlCall,-(A0)⓪(BRA cont0⓪ isExc MOVE.L #hdlExc,-(A0)⓪ cont0 MOVE #JSRInstr,-(A0)⓪(⓪(MOVE.L A0,(A3) ; neuen vektor auf 'JSR hdlExc/hdlCall'⓪(⓪(; ③neuen Prozeß starten④⓪(TST.W (A6)+⓪(BEQ stUsr⓪(BMI stSup⓪(⓪(; starte Usermode, vorher Vektor restaurieren⓪(MOVE.L (A6)+,D0 ; alter Vektor⓪(MOVE.L 4+2+4+4(A6),A0 ; D1: Vektoradr.⓪(MOVE.L D0,(A0)⓪(TST has020⓪(BEQ no20h⓪(MOVE #DftSF,-(A7)⓪ no20h:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stUsr: ; starte Usermode⓪(TST has020⓪(BEQ no20i⓪(MOVE #DftSF,-(A7)⓪ no20i:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stSup: ; starte Supervisormode⓪(MOVE.L A6,A7⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,USP⓪(MOVEM.L (A7)+,D0-A6⓪(ADDQ.L #4,A7⓪(TST has020⓪(BEQ no20j⓪(MOVE.W (A7),-(A7)⓪(MOVE.L 4(A7),2(A7)⓪(MOVE #DftSF,6(A7)⓪ no20j:⓪(RTE⓪$END⓪"END @IOTR;⓪ ⓪ ⓪ PROCEDURE @IOCA ( vecAddr:ADDRESS );⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A1⓪(CMPA.L #$400,A1⓪(BCS isExc⓪(MOVEM.L D3-D7/A3-A6,-(A7)⓪(; JSR EnterSupervisorMode ; Regs D0,A0 können verändert werden !⓪(MOVE.L (A1),A1⓪(JSR (A1)⓪(ANDI #$CFFF,SR⓪(MOVEM.L (A7)+,D3-D7/A3-A6⓪(RTS⓪&isExc:⓪(MOVE.L (A7)+,A2⓪(MOVE SR,D1⓪(; JSR EnterSupervisorMode ; Regs D0,A0 können verändert werden !⓪(MOVE.L (A1),A1⓪(TST has020⓪(BEQ no20k⓪(MOVE #DftSF,-(A7)⓪ no20k:⓪(MOVE.L A2,-(A7)⓪(MOVE D1,-(A7)⓪(JMP (A1) ; rettet sicher alle Register⓪$END⓪"END @IOCA;⓪ ⓪ ⓪ PROCEDURE @PRIO; (* Set Interrupt Priority *)⓪"BEGIN⓪$(* IR-level in D2, auf Bitpos. wie SR; A2 nicht verändern ! *);⓪$ASSEMBLER⓪(MOVE SR,D0⓪(BTST #13,D0⓪(BNE sup ; wir sind im Supervisormode⓪(; JSR EnterSupervisorMode⓪(MOVE D2,SR⓪(RTS⓪&sup:⓪(ANDI #$F0FF,D0⓪(ANDI #$0F00,D2⓪(OR D2,D0⓪(MOVE D0,SR⓪$END⓪"END @PRIO;⓪ ⓪ ⓪ PROCEDURE @EXCL; (* Exclude Element aus Set *)⓪"⓪"BEGIN (* SetAdr und Element auf Stack *)⓪$ASSEMBLER⓪'MOVE.W -(A3),D0⓪'MOVE.W D0,D1⓪'LSR.W #3,D0⓪'MOVE.L -(A3),A0⓪'BCLR D1,0(A0,D0.W) END⓪"END @EXCL;⓪"⓪ ⓪ PROCEDURE @INCL; (* Include Element in Set *)⓪ ⓪"BEGIN (* SetAdr und Element auf Stack *)⓪$ASSEMBLER⓪(MOVE.W -(A3),D0⓪(MOVE.W D0,D1⓪(LSR.W #3,D0⓪(MOVE.L -(A3),A0⓪(BSET D1,0(A0,D0.W) END⓪$END @INCL;⓪"⓪ ⓪ PROCEDURE @SAND; (* '*' auf Sets *)⓪ ⓪#BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪)ASSEMBLER⓪+MOVE.L A3,A0⓪+ADDQ.W #1,D0⓪+BCLR #0,D0 ;sync. D0⓪+SUBA.W D0,A0⓪%Lp MOVE.W -(A3),D1⓪+AND.W D1,-(A0)⓪+SUBQ.W #2,D0⓪+BHI Lp⓪)END⓪#END @SAND;⓪!⓪ ⓪ PROCEDURE @SXOR; (* '/' auf Sets *)⓪ ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪(ASSEMBLER⓪*MOVE.L A3,A0⓪*ADDQ.W #1,D0⓪*BCLR #0,D0 ;sync. D0⓪*SUBA.W D0,A0⓪$Lp MOVE.W -(A3),D1⓪*EOR.W D1,-(A0)⓪*SUBQ.W #2,D0⓪*BHI Lp⓪(END⓪"END @SXOR;⓪!⓪ ⓪ PROCEDURE @SSUM; (* '+' auf Sets *)⓪ ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪(ASSEMBLER⓪*MOVE.L A3,A0⓪*ADDQ.W #1,D0⓪*BCLR #0,D0 ;sync. D0⓪*SUBA.W D0,A0⓪$Lp MOVE.W -(A3),D1⓪*OR.W D1,-(A0)⓪*SUBQ.W #2,D0⓪*BHI Lp⓪(END⓪"END @SSUM;⓪!⓪ ⓪ PROCEDURE @SDIF; (* '-' auf Sets *)⓪ ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪(ASSEMBLER⓪*MOVE.L A3,A0⓪*ADDQ.W #1,D0⓪*BCLR #0,D0 ;sync. D0⓪*SUBA.W D0,A0⓪$Lp MOVE.W -(A3),D1⓪*AND.W -(A0),D1⓪*EOR.W D1,(A0)⓪*SUBQ.W #2,D0⓪*BHI Lp⓪(END⓪"END @SDIF;⓪ ⓪ ⓪ PROCEDURE @SMEM; (* IN-Operator auf Sets *)⓪ ⓪"BEGIN (* Element.W und Set auf Stack, SetLaenge in D0 *)⓪$ASSEMBLER⓪(MOVE.W D0,D1⓪(NEG.W D1⓪(BCLR #0,D1⓪(LEA 0(A3,D1.W),A0 ;A0 ist ^SetAnfang⓪(MOVE.W -(A0),D2⓪(MOVE.W D2,D1⓪(LSR.W #3,D2⓪(CMP.W D0,D2⓪(BCC NOMEM⓪(BTST D1,2(A0,D2.W)⓪(BEQ NOMEM⓪(MOVE.L A0,A3⓪(MOVE.W #1,(A3)+⓪(RTS⓪&NOMEM⓪(MOVE.L A0,A3⓪(CLR (A3)+⓪$END⓪"END @SMEM;⓪"⓪ ⓪ PROCEDURE @SEQL; (* '=' auf Sets *)⓪ ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪(ASSEMBLER⓪*MOVE.W D0,D1⓪*NEG.W D1⓪*BCLR #0,D1⓪*LEA 0(A3,D1.W),A0 ;^Anfang des 2. Sets⓪*LEA 0(A0,D1.W),A1 ;^Anfang des 1. Sets⓪*MOVE.L A1,D1⓪*SUBQ.W #1,D0⓪$Lp CMPM.B (A0)+,(A1)+⓪*DBNE D0,Lp⓪*SEQ D0⓪*AND.W #1,D0⓪*MOVE.L D1,A3⓪*MOVE.W D0,(A3)+⓪(END⓪"END @SEQL;⓪ ⓪ ⓪ PROCEDURE @SNEQ; (* '#' auf Sets *)⓪ ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪(ASSEMBLER⓪*MOVE.W D0,D1⓪*NEG.W D1⓪*BCLR #0,D1⓪*LEA 0(A3,D1.W),A0 ;^Anfang des 2. Sets⓪*LEA 0(A0,D1.W),A1 ;^Anfang des 1. Sets⓪*MOVE.L A1,D1⓪*SUBQ.W #1,D0⓪$Lp CMPM.B (A0)+,(A1)+⓪*DBNE D0,Lp⓪*SNE D0⓪*AND.W #1,D0⓪*MOVE.L D1,A3⓪*MOVE.W D0,(A3)+⓪(END⓪"END @SNEQ;⓪ ⓪ ⓪ PROCEDURE @SLEQ; (* '<=' auf Sets *)⓪ ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪(ASSEMBLER⓪*MOVE.W D0,D1⓪*NEG.W D1⓪*BCLR #0,D1⓪*LEA 0(A3,D1.W),A0 ;^Anfang des 2. Sets⓪*LEA 0(A0,D1.W),A1 ;^Anfang des 1. Sets⓪*MOVE.L A1,D2⓪*SUBQ.W #1,D0⓪$Lp MOVE.B (A1),D1⓪*AND.B (A0)+,D1⓪*EOR.B D1,(A1)+ ;Set1 * Set2 =! Set1⓪*DBNE D0,Lp⓪*SEQ D0⓪*AND.W #1,D0⓪*MOVEA.L D2,A3⓪*MOVE.W D0,(A3)+⓪(END⓪"END @SLEQ;⓪ ⓪ ⓪ PROCEDURE @SGEQ; (* '>=' auf Sets *)⓪ ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)⓪(ASSEMBLER⓪*MOVE.W D0,D1⓪*NEG.W D1⓪*BCLR #0,D1⓪*LEA 0(A3,D1.W),A0 ;^Anfang des 2. Sets⓪*LEA 0(A0,D1.W),A1 ;^Anfang des 1. Sets⓪*MOVE.L A1,D2⓪*SUBQ.W #1,D0⓪$Lp MOVE.B (A0),D1⓪*AND.B (A1)+,D1⓪*EOR.B D1,(A0)+ ;Set1 * Set2 =! Set2⓪*DBNE D0,Lp⓪*SEQ D0⓪*AND.W #1,D0⓪*MOVEA.L D2,A3⓪*MOVE.W D0,(A3)+⓪(END⓪"END @SGEQ;⓪ ⓪ (********* Real-Vergleiche *********)⓪ ⓪ PROCEDURE @REEQ (a,b:LONGREAL):BOOLEAN; (* a = b *)⓪ BEGIN⓪"ASSEMBLER⓪$; !!! sind bei 881 nicht unbenutzte Bits, die hier falsche Erg. liefern k?⓪$MOVE.L -(A3),D0⓪$MOVE.L -(A3),D1⓪$MOVE.L -(A3),D2⓪$CMP.L -(A3),D1⓪$BNE NE⓪$CMP.L D0,D2⓪$BNE NE⓪$MOVE.W #true,(A3)+⓪$RTS⓪ !NE CLR.W (A3)+⓪"END⓪ END @REEQ;⓪ ⓪ PROCEDURE @RENE (a,b:LONGREAL):BOOLEAN; (* a # b *)⓪ BEGIN⓪"ASSEMBLER⓪$; !!! sind bei 881 nicht unbenutzte Bits, die hier falsche Erg. liefern k?⓪$MOVE.L -(A3),D0⓪$MOVE.L -(A3),D1⓪$MOVE.L -(A3),D2⓪$CMP.L -(A3),D1⓪$BNE NE⓪$CMP.L D0,D2⓪$BNE NE⓪$CLR.W (A3)+⓪$RTS⓪ !NE MOVE.W #true,(A3)+⓪"END⓪ END @RENE;⓪ ⓪ (*********** Longint - Arithmetik ***********)⓪ ⓪ PROCEDURE @IMUL (a,b:LONGINT):LONGINT;⓪ BEGIN⓪#ASSEMBLER⓪'MOVE.L D3,-(A7)⓪'CLR.W D3⓪'MOVE.L -(A3),D0⓪'BPL IMUL5⓪'NEG.L D0⓪'MOVEQ #1,D3⓪ !IMUL5 MOVE.L -(A3),D1⓪'BPL IMUL4⓪'NEG.L D1⓪'BCHG #0,D3⓪ !IMUL4 MOVE.L D0,D2⓪'MULU D1,D0⓪'SWAP D1⓪'TST.W D1⓪'BEQ IMUL1⓪'SWAP D2⓪'TST.W D2⓪'BEQ IMUL2⓪'BNE IMERR⓪ !IMUL1 SWAP D1⓪ !IMUL2 SWAP D2⓪'MULU D1,D2⓪'SWAP D2⓪'TST.W D2⓪'BNE IMERR⓪'ADD.L D2,D0⓪'BVS IMERR⓪'BMI IMERR⓪'TST.W D3⓪'BEQ IMUL3⓪'NEG.L D0⓪ !IMUL3 MOVE.L D0,(A3)+⓪'MOVE.L (A7)+,D3⓪'RTS⓪'⓪ !IMERR LINK A5,#0⓪'TRAP #6 ; Overflow⓪'DC.W -7-$4000⓪'CLR.L (A3)+⓪'MOVE.L (A7)+,D3⓪'UNLK A5⓪#END⓪ END @IMUL;⓪ ⓪ PROCEDURE @CMUL (a,b:LONGCARD):LONGCARD;⓪ BEGIN⓪"ASSEMBLER⓪'MOVE.L -(A3),D0⓪'MOVE.L -(A3),D1⓪'MOVE.L D0,D2⓪'MULU D1,D0⓪'SWAP D1⓪'TST.W D1⓪'BEQ CMUL1⓪'SWAP D2⓪'TST.W D2⓪'BEQ CMUL2⓪'BNE CMERR⓪ !CMUL1 SWAP D1⓪ !CMUL2 SWAP D2⓪'MULU D1,D2⓪'SWAP D2⓪'TST.W D2⓪'BNE CMERR⓪'ADD.L D2,D0⓪'BCS CMERR⓪'MOVE.L D0,(A3)+⓪'RTS⓪'⓪ !CMERR LINK A5,#0⓪'TRAP #6 ; Overflow⓪'DC.W -7-$4000⓪'CLR.L (A3)+⓪'UNLK A5⓪#END⓪ END @CMUL;⓪ ⓪ PROCEDURE @IDIV (a,b:LONGINT):LONGINT;⓪ BEGIN⓪#ASSEMBLER⓪(MOVEM.L D4-D5,-(A7)⓪(⓪(CLR.W D5⓪(MOVE.L -(A3),D0⓪(BEQ IDERR⓪(BPL IDIV5⓪(NEG.L D0⓪(MOVEQ #1,D5⓪ !IDIV5 MOVE.L -(A3),D1⓪(BPL IDIV6⓪(NEG.L D1⓪(BCHG #0,D5⓪ !IDIV6 CLR.L D2⓪(CLR.L D4⓪ !IDIV1 CMP.L D0,D1⓪(BLS IDIV2⓪(LSL.L #1,D0⓪(ADDQ.W #1,D2⓪(BRA IDIV1⓪ !IDIV3 LSR.L #1,D0⓪ !IDIV2 LSL.L #1,D4⓪(CMP.L D0,D1⓪(BCS IDIV4⓪(SUB.L D0,D1⓪(ADDQ.W #1,D4⓪ !IDIV4 DBF D2,IDIV3⓪(TST.W D5⓪(BEQ IDIV7⓪(NEG.L D4⓪ !IDIV7 MOVE.L D4,(A3)+⓪(MOVEM.L (A7)+,D4-D5⓪(RTS⓪(⓪ !IDERR LINK A5,#0⓪(TRAP #6 ; Div by zero⓪(DC.W -5-$4000⓪(CLR.L (A3)+⓪(MOVEM.L (A7)+,D4-D5⓪(UNLK A5⓪$END⓪ END @IDIV;⓪ ⓪ PROCEDURE @CDIV (a,b:LONGCARD):LONGCARD;⓪ BEGIN⓪ ASSEMBLER⓪'MOVE.L D3,-(A7)⓪'MOVE.L -(A3),D0⓪'BEQ CDERR⓪'MOVE.L -(A3),D1⓪'CLR.L D2⓪'CLR.L D3⓪'TST.L D0⓪'BMI CDIV2⓪ !CDIV1 CMP.L D0,D1⓪'BLS CDIV2⓪'ADDQ #1,D2⓪'ASL.L #1,D0⓪'BPL CDIV1⓪ !CDIV2 ASL.L #1,D3⓪'CMP.L D0,D1⓪'BCS CDIV3⓪'SUB.L D0,D1⓪'ADDQ #1,D3⓪ !CDIV3 LSR.L #1,D0⓪'DBF D2,CDIV2⓪'MOVE.L D3,(A3)+⓪'MOVE.L (A7)+,D3⓪'RTS⓪'⓪ !CDERR LINK A5,#0⓪'TRAP #6 ; Div by zero⓪'DC.W -5-$4000⓪'CLR.L (A3)+⓪'MOVE.L (A7)+,D3⓪'UNLK A5⓪ END⓪ END @CDIV;⓪ ⓪ PROCEDURE @IMOD (a,b:LONGINT):LONGINT;⓪ BEGIN⓪ ASSEMBLER⓪'MOVE.L D5,-(A7)⓪'CLR.W D5⓪'CLR.L D2⓪'MOVE.L -(A3),D0⓪'BEQ IMODER⓪'BPL IMOD2⓪'NEG.L D0⓪ !IMOD2 MOVE.L -(A3),D1⓪'BPL IMOD1⓪'NEG.L D1⓪'MOVEQ #1,D5⓪ !IMOD1 CMP.L D0,D1⓪'BLS IMOD5⓪'LSL.L #1,D0⓪'ADDQ.W #1,D2⓪'BRA IMOD1⓪ !IMOD3 LSR.L #1,D0⓪ !IMOD5 CMP.L D0,D1⓪'BCS IMOD4⓪'SUB.L D0,D1⓪ !IMOD4 DBEQ D2,IMOD3⓪'TST.W D5⓪'BEQ IMOD6⓪'NEG.L D1⓪ !IMOD6 MOVE.L D1,(A3)+⓪'MOVE.L (A7)+,D5⓪'RTS⓪'⓪ IMODER LINK A5,#0⓪'TRAP #6 ; Div by zero⓪'DC.W -5-$4000⓪'CLR.L (A3)+⓪'MOVE.L (A7)+,D5⓪'UNLK A5⓪#END⓪ END @IMOD;⓪ ⓪ PROCEDURE @CMOD (a,b:LONGCARD):LONGCARD;⓪ BEGIN⓪ ASSEMBLER⓪'MOVE.L D3,-(A7)⓪'MOVE.L -(A3),D0⓪'BEQ CMERR⓪'MOVE.L -(A3),D1⓪'CLR.L D2⓪'MOVE.L D0,D3⓪'BMI CMOD2⓪ !CMOD1 CMP.L D0,D1⓪'BLS CMOD2⓪'ADDQ #1,D2⓪'ASL.L #1,D0⓪'BPL CMOD1⓪ !CMOD2 CMP.L D0,D1⓪'BCS CMOD3⓪'SUB.L D0,D1⓪ !CMOD3 LSR.L #1,D0⓪'CMP.L D1,D3⓪'DBHI D2,CMOD2⓪'⓪'MOVE.L D1,(A3)+⓪'MOVE.L (A7)+,D3⓪'RTS⓪'⓪ !CMERR LINK A5,#0⓪'TRAP #6 ; Div by zero⓪'DC.W -5-$4000⓪'CLR.L (A3)+⓪'MOVE.L (A7)+,D3⓪'UNLK A5⓪#END⓪ END @CMOD;⓪ ⓪ PROCEDURE @ASGN;⓪ BEGIN⓪#ASSEMBLER⓪'MOVE.L -(A3),A0⓪$!X MOVE.W (A0)+,(A4)+⓪'DBF D0,X⓪#END⓪ END @ASGN;⓪ ⓪ PROCEDURE @STAS;⓪ (* D0: LAENGE DES SOURCESTRING/BYTE; D1: LAENGE DEST.STRING/BYTE *)⓪ BEGIN⓪#ASSEMBLER⓪'MOVE.L A3,A0⓪'MOVE.L D0,D2⓪'ADDQ.L #1,D0 ; D0 als StackOffset: muss synch. werden!⓪'ANDI.W #$FFFE,D0 ; nicht BCLR verwenden, sonst Fehler bei DBEQ (unten)⓪'SUBA.L D0,A0 ; A0 zeigt auf Sourcestring⓪'BRA y⓪$⓪$z SWAP D1 ;*** Kopierschleife⓪$x SUBQ.L #1,D2⓪'BCS ok2 ; Source-Ende, Dest. muss Endmarke bekommen⓪'MOVE.B (A0)+,(A4)+⓪$y DBEQ D1,x⓪'BEQ ok ; Endmarke der Source wurde eben kopiert⓪'SWAP D1⓪'DBF D1,z⓪'⓪'TST.L D2 ;*** Ende der Schleife, weil Dest voll⓪'BEQ ok ; Source komplett kopiert (hatte keine Endmarke)⓪'TST.B (A0)⓪'BEQ ok ; sonst muss die Endmarke das naechste Zeichen sein⓪'SUBA.L D0,A3 ; leider nein: String Overflow⓪'TRAP #6⓪'DC.W -8-$4000⓪#ok2 CLR.B (A4)+⓪#ok SUBA.L D0,A3⓪#END⓪ END @STAS;⓪ ⓪ ⓪ PROCEDURE @COPY;⓪"BEGIN⓪$ASSEMBLER⓪&move.l (a7)+,A1 ;Ruecksprung-Adr⓪&⓪&; Platzbedarf ausrechnen⓪&⓪&move.w -2(a3),d1 ;High-Wert⓪&addq.w #1,d1 ;Anzahl Elemente⓪&mulu d0,d1 ; * Elementlaenge = Anzahl Bytes⓪&addq.l #1,d1 ;synchronisieren⓪&bclr #0,d1⓪&⓪&; Platz reservieren, Pointer bereitstellen⓪&⓪&suba.l d1,a7⓪&movea.l -6(a3),A2 ;^ Source-Daten⓪&move.l a7,-6(a3) ;neuer ^ Kopie⓪&movea.l a7,a0 ;^ fuer Kopierschleife⓪&move.l d1,-(a7) ;fuer Release⓪&⓪&; Kopierschleife⓪&⓪&bra lp2⓪!lp1 swap d1⓪!lp move.b (A2)+,(a0)+ ;schoen langsam umkopieren...⓪!lp2 dbf d1,lp⓪&swap d1⓪&dbf d1,lp1⓪&⓪&jmp (A1) ;zurueck zum Aufrufer⓪$END⓪"END @COPY;⓪ ⓪ ⓪ PROCEDURE @COPS;⓪"BEGIN⓪$ASSEMBLER⓪&move.l (a7)+,A1 ;Ruecksprung-Adr⓪&move.l (a7)+,d2 ;Adresse der zu rufenden Prozedur retten⓪&⓪&; Platzbedarf ausrechnen⓪&⓪&move.w -2(a3),d1 ;High-Wert⓪&addq.w #1,d1 ;Anzahl Elemente⓪&mulu d0,d1 ; * Elementlaenge = Anzahl Bytes⓪&addq.l #1,d1 ;synchronisieren⓪&bclr #0,d1⓪&⓪&; Platz reservieren, Pointer bereitstellen⓪&⓪&suba.l d1,a7⓪&movea.l -6(a3),A2 ;^ Source-Daten⓪&move.l a7,-6(a3) ;neuer ^ Kopie⓪&movea.l a7,a0 ;^ fuer Kopierschleife⓪&move.l d1,-(a7) ;fuer Release⓪&⓪&; Kopierschleife⓪&⓪&bra lp2⓪!lp1 swap d1⓪!lp move.b (A2)+,(a0)+ ;schoen langsam umkopieren...⓪!lp2 dbf d1,lp⓪&swap d1⓪&dbf d1,lp1⓪&⓪&move.l d2,-(a7)⓪&jmp (A1) ;zurueck zum Aufrufer⓪$END⓪"END @COPS;⓪ ⓪ PROCEDURE @SCAS; END @SCAS;⓪ ⓪ PROCEDURE @RES1; (* Procedure Entry ohne Priority *)⓪"BEGIN⓪$ASSEMBLER⓪(; Null-Link (keine Parameter, keine lok. Vars), norm. $200 Stack-Check⓪(LEA $200(A3),A0⓪(CMPA.L A7,A0⓪(BCC stackerror⓪&cont⓪(MOVE.L (A7)+,A0⓪(LINK A5,#$0000⓪(MOVE.L A7,A2⓪(MOVEM.L A4/A6,-(A7)⓪(MOVE.L A2,A6⓪(JMP (A0)⓪&stackerror⓪(TRAP #6⓪(DC.W $BFF6 ; Stack overflow, caller caused⓪(BRA cont⓪$END⓪"END @RES1;⓪ ⓪ PROCEDURE @RES2; (* Procedure Entry ohne Priority *)⓪"BEGIN⓪$ASSEMBLER⓪(; D0.W: Link-Wert⓪(; als Stacksicherheitswert wird $200 angenommen⓪(LEA $200(A3),A0⓪(ADDA.W D0,A0⓪(CMPA.L A7,A0⓪(BCC stackerror⓪&cont⓪(MOVE.L (A7)+,A0⓪(; LINK #<D0>,A5:⓪(MOVE.L A5,-(A7)⓪(MOVE.L A7,A5⓪(SUBA.W D0,A7⓪(⓪(MOVE.L A7,A2⓪(MOVEM.L A4/A6,-(A7)⓪(MOVE.L A2,A6⓪(JMP (A0)⓪&stackerror⓪(TRAP #6⓪(DC.W $BFF6 ; Stack overflow, caller caused⓪(BRA cont⓪$END⓪"END @RES2;⓪ ⓪ PROCEDURE @RES3; END @RES3;⓪ PROCEDURE @RES4; END @RES4;⓪ PROCEDURE @RES5; END @RES5;⓪ PROCEDURE @RES6; END @RES6;⓪ PROCEDURE @RES7; END @RES7;⓪ PROCEDURE @RES8; END @RES8;⓪ PROCEDURE @RES9; END @RES9;⓪ ⓪ ⓪ PROCEDURE CAP (ch: CHAR): CHAR;⓪ BEGIN⓪"ASSEMBLER⓪(CLR D0⓪(MOVE.B -2(A3),D0⓪(LEA tab(PC),A0⓪(MOVE.B 0(A0,D0.W),-2(A3)⓪(RTS⓪"⓪"tab: DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F⓪(DC.B ' ','!','"','#','$','%','&',$27,'(',')','*','+',',','-','.','/'⓪(DC.B '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'⓪(DC.B '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','[','\',']','^','_'⓪(DC.B '`','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','{','|','}','~',''⓪(DC.B 'Ç','Ü','É','A','Ä','À','Å','Ç','E','E','E','I','I','I','Ä','Å'⓪(DC.B 'É','Æ','Æ','O','Ö','O','U','U','ÿ','Ö','Ü','¢','£','¥','ß','ƒ'⓪(DC.B 'A','I','O','U','Ñ','Ñ','ª','º','¿','⌐','¬','½','¼','¡','«','»'⓪(DC.B 'Ã','Õ','Ø','Ø','Œ','Œ','À','Ã','Õ','¨','´','†','¶','©','®','™'⓪(DC.B 'IJ','IJ','א','ב','ג','ד','ה','ו','ז','ח','ט','י','כ','ל','מ','נ'⓪(DC.B 'ס','ע','פ','צ','ק','ר','ש','ת','ן','ך','ם','ף','ץ','§','∧','∞'⓪(DC.B 'α','β','Γ','π','Σ','σ','µ','τ','Φ','Θ','Ω','δ','∮','ϕ','∈','∩'⓪(DC.B '≡','±','≥','≤','⌠','⌡','÷','≈','°','∙','·','√','ⁿ','²','³','¯'⓪"END⓪ END CAP;⓪ ⓪ ⓪ PROCEDURE CHR (c: WORD): CHAR;⓪ BEGIN ASSEMBLER⓪(MOVE.B -(A3),D0 ;Low-Byte wird Char⓪(TST.B -(A3)⓪(BEQ ok ;High-Byte muss 0 sein⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -7-$4000 ;Overflow⓪(UNLK A5⓪#ok MOVE.B D0,(A3)+⓪(CLR.B (A3)+⓪'END⓪ END CHR;⓪ ⓪ PROCEDURE HALT;⓪ BEGIN⓪"ASSEMBLER⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -11-$4000 ; HALT⓪(UNLK A5⓪"END⓪ END HALT;⓪ ⓪ PROCEDURE FLOAT(i: LONGCARD): LONGREAL;⓪ BEGIN⓪"ASSEMBLER⓪ (*$? ~A68881 & ~M68881:⓪&MOVE.W #$0102,D0 ;Exponent 32⓪&MOVE.L -(A3),D1⓪&BEQ ZERO⓪&BMI Large ;ist linksbündig⓪ POS SUBQ.W #8,D0 ;linksbündig machen⓪&LSL.L #1,D1⓪&BPL POS⓪ Large SWAP D0⓪&SWAP D1⓪&MOVE.W D1,D0⓪&CLR.W D1⓪&MOVE.L D0,(A3)+⓪&MOVE.L D1,(A3)+⓪&RTS⓪ !ZERO CLR.L (A3)+⓪&CLR.L (A3)+⓪ *)⓪ (*$? M68881:⓪(FMOVE.L -(A3),FP0 ; kein Runtime-Fehler möglich⓪(FMOVE.D FP0,(A3)+⓪ *)⓪ (*$? A68881:⓪(; FMOVE.L -(A3),FP0 ; kein Runtime-Fehler möglich⓪(MOVE.W #$4000,fpcmd⓪ DoDl1 TST.B fpstatlo⓪(BEQ DoDl1⓪(MOVE.L -(A3),fpop⓪(; FMOVE.D FP0,(A3)+⓪(MOVE.W #$7400,fpcmd⓪ DoDl3 MOVE.B fpstatlo,D0⓪(BEQ DoDl3⓪(MOVE.L fpop,(A3)+⓪(MOVE.L fpop,(A3)+⓪(TST.B fpstatlo⓪ *)⓪"END⓪ END FLOAT;⓪ ⓪ PROCEDURE TRUNC(r: LONGREAL): LONGCARD;⓪ BEGIN⓪"ASSEMBLER⓪ (*$? ~A68881 & ~M68881:⓪'LINK A5,#0⓪'MOVEM.L D3-D4,-(A7)⓪ ⓪'MOVE.L -(A3),D0⓪'MOVE.L -(A3),D1⓪'SWAP D1⓪'BTST #0,D1⓪'BNE nega ;Zahl ist negativ -> Fehler⓪'ASR.W #3,D1⓪'MOVE.W #32,D4⓪'SUB.W D1,D4⓪'BLT Err ;Exponent war > 32: 0.FFF.. * 2^32 ist MaxLCard⓪'CMP.W #32,D4⓪'BCC ZERO ;Exponent war <= 0⓪'MOVE.L D1,D2⓪'SWAP D0⓪'MOVE.W D0,D2⓪'LSR.L D4,D2⓪'BRA X⓪!!ZERO CLR.L D2⓪!!X MOVE.L D2,(A3)+⓪'MOVEM.L (A7)+,D3-D4⓪'UNLK A5⓪'RTS⓪ ⓪!!NEGA TRAP #6⓪'DC.W -6-$4000 ; Out of range: Arg. ist negativ⓪'BRA cont⓪!!ERR TRAP #6⓪'DC.W -7-$4000 ; Overflow: Arg. ist > MaxLCard⓪!!CONT CLR.L (A3)+⓪'MOVEM.L (A7)+,D3-D4⓪'UNLK A5⓪ *)⓪ (*$? M68881:⓪(; !!! Abfrage auf neg. Ergebnis und Überlauf fehlt noch!⓪(FINTRZ.D -(A3),FP0⓪(FMOVE.L FP0,(A3)+⓪ *)⓪ (*$? A68881:⓪(; !!! Abfrage auf neg. Ergebnis fehlt noch!⓪(; FINTRZ.D -(A3),FP0⓪(MOVE.W #$5403,fpcmd⓪ DoDl1 MOVE.B fpstatlo,D0⓪(BEQ DoDl1⓪(CMPI.B #8,D0⓪(BNE error2⓪(MOVE.L -8(A3),fpop⓪(MOVE.L -(A3),fpop⓪(SUBQ.L #4,A3⓪(; FMOVE.L FP0,(A3)+⓪(MOVE.W #$6000,fpcmd⓪ DoDl3 MOVE.B fpstatlo,D0⓪(BEQ DoDl3⓪(CMPI.B #2,D0⓪(BNE error⓪(MOVE.L fpop,(A3)+⓪(TST.B fpstatlo⓪(RTS⓪ error2 SUBQ.L #8,A3⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L (A3)+⓪ *)⓪"END⓪ END TRUNC;⓪ ⓪ ⓪ (*$? A68881:⓪ PROCEDURE DoComp;⓪ BEGIN⓪"ASSEMBLER⓪+LEA -16(A3),A3⓪+MOVE.L A3,A0⓪+MOVE.W #$5400,fpcmd⓪"!DoCl1 TST.B fpstatlo⓪+BEQ DoCl1⓪+MOVE.L (A0)+,fpop⓪+MOVE.L (A0)+,fpop⓪+MOVE.W #$5438,fpcmd ;FCMP ?,FP0⓪"!DoCl2 MOVE.B fpstatlo,D0⓪+BEQ DoCl2⓪+CMPI.B #8,D0⓪+BNE DoCError⓪+MOVE.L (A0)+,fpop⓪+MOVE.L (A0)+,fpop⓪+MOVE.W D1,fpcond⓪+CLR.W D0⓪+MOVE.B fpstatlo,D0⓪+MOVE.W D0,(A3)+⓪+RTS⓪"!DoCError⓪+LINK A5,#0⓪+JSR FPUError⓪+UNLK A5⓪+CLR (A3)+⓪"END;⓪ END DoComp;⓪ *)⓪ ⓪ ⓪ PROCEDURE @RELE (a,b:LONGREAL):BOOLEAN; (* Op1 <= Op2, neu *)⓪ BEGIN ASSEMBLER⓪&(*$? ~A68881:⓪(MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L -(A3),D0 ;zweiter Operand⓪(MOVE.L -(A3),D1⓪(BEQ zer2⓪(MOVE.L -(A3),D2 ;erster Operand⓪(MOVE.L -(A3),D3⓪(BEQ zer1⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BLS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BLS neg3⓪!neg2 CLR.W (A3)+ ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 SUBQ.L #4,A3 ;Op2 Null, Op1 <= 0 ?⓪(MOVE.L -(A3),D3⓪(BEQ neg3 ;Op1 = Op2 = 0⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0; Op1 < 0⓪(BRA neg2⓪!zer1 BTST D4,D1 ;Op1 Null, Op2 # 0: ist Op2 < 0?⓪(BNE neg2 ; ja⓪!neg3 MOVEM.L (A7)+,D3/D4⓪(MOVE.W #TRUE,(A3)+⓪&*)⓪&(*$? A68881:⓪(MOVE.W #$15,D1 ;Conditional LE⓪(JMP DoComp⓪&*)⓪'END⓪ END @RELE;⓪ ⓪ PROCEDURE @REGE (a,b:LONGREAL):BOOLEAN;⓪ BEGIN ASSEMBLER⓪&(*$? ~A68881:⓪(MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L -(A3),D0 ;zweiter Operand⓪(MOVE.L -(A3),D1⓪(BEQ zer2⓪(MOVE.L -(A3),D2 ;erster Operand⓪(MOVE.L -(A3),D3⓪(BEQ zer1⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BCS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BCS neg3⓪!neg2 MOVE.W #true,(A3)+ ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 SUBQ.L #4,A3 ;Op2 Null, Op1 <= 0 ?⓪(MOVE.L -(A3),D3⓪(BEQ neg2 ;beide Null⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0, Op1 < 0⓪(BRA neg2 ;Op2 = 0, Op1 > 0⓪!zer1 BTST D4,D1 ;Op1 = 0, Op2 # 0: ist Op2 > 0?⓪(BNE neg2 ; nein⓪!neg3 CLR.W (A3)+ ;Op1 negativ, Op2 positiv⓪(MOVEM.L (A7)+,D3/D4⓪&*)⓪&(*$? A68881:⓪(MOVE.W #$13,D1 ;Conditional GE⓪(JMP DoComp⓪&*)⓪#END⓪ END @REGE;⓪ ⓪ PROCEDURE @RELT (a,b:LONGREAL):BOOLEAN;⓪ BEGIN ASSEMBLER⓪&(*$? ~A68881:⓪(MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L -(A3),D0 ;zweiter Operand⓪(MOVE.L -(A3),D1⓪(BEQ zer2⓪(MOVE.L -(A3),D2 ;erster Operand⓪(MOVE.L -(A3),D3⓪(BEQ zer1⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BCS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BCS neg3⓪!neg2 CLR.W (A3)+ ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 SUBQ.L #4,A3 ;Op2 Null, Op1 <= 0 ?⓪(MOVE.L -(A3),D3⓪(BEQ neg2 ;beide Null⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0, Op1 < 0⓪(BRA neg2 ;Op2 = 0, Op1 > 0⓪!zer1 BTST D4,D1 ;Op1 = 0, Op2 # 0: ist Op2 > 0?⓪(BNE neg2 ; nein⓪!neg3 MOVE.W #TRUE,(A3)+ ;Op1 negativ, Op2 positiv⓪(MOVEM.L (A7)+,D3/D4⓪&*)⓪&(*$? A68881:⓪(MOVE.W #$14,D1 ;Conditional LT⓪(JMP DoComp⓪&*)⓪&END⓪ END @RELT;⓪ ⓪ PROCEDURE @REGT (a,b:LONGREAL):BOOLEAN;⓪ BEGIN⓪"ASSEMBLER⓪"(*$? ~A68881:⓪(MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L -(A3),D0 ;zweiter Operand⓪(MOVE.L -(A3),D1⓪(BEQ zer2⓪(MOVE.L -(A3),D2 ;erster Operand⓪(MOVE.L -(A3),D3⓪(BEQ zer1⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BLS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BLS neg3⓪!neg2 MOVE.W #true,(A3)+ ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 SUBQ.L #4,A3 ;Op2 Null, Op1 <= 0 ?⓪(MOVE.L -(A3),D3⓪(BEQ neg3 ;beide Null⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0, Op1 < 0⓪(BRA neg2 ;Op2 = 0, Op1 > 0⓪!zer1 BTST D4,D1 ;Op1 = 0, Op2 # 0: ist Op2 > 0?⓪(BNE neg2 ; nein⓪!neg3 CLR.W (A3)+ ;Op1 negativ, Op2 positiv⓪(MOVEM.L (A7)+,D3/D4⓪!*)⓪!(*$? A68881:⓪(MOVE.W #$12,D1 ;Conditional GT⓪(JMP DoComp⓪!*)⓪&END⓪ END @REGT;⓪ ⓪ ⓪ (********* Real-Arithmetik *********)⓪ PROCEDURE @RNEG (a:LONGREAL):LONGREAL;⓪ BEGIN⓪"ASSEMBLER⓪"(*$? ~A68881:⓪(TST.W -8(A3)⓪(BEQ ZERO⓪(BCHG #0,-7(A3)⓪"!ZERO⓪"*)⓪"(*$? A68881:⓪(TST -8(A3)⓪(BEQ zero⓪(BCHG #7,-8(A3)⓪"!zero RTS⓪"*)⓪$RTS⓪"END⓪ END @RNEG;⓪ ⓪ (*$? A68881:⓪ PROCEDURE DoDouble;⓪ (* Erwartet in Register D1 eine Co-Instruction *)⓪ BEGIN⓪"ASSEMBLER⓪+LEA -16(A3),A3⓪+MOVE.L A3,A0⓪+MOVE.W #$5400,fpcmd⓪"!DoDl1 TST.B fpstatlo⓪+BEQ DoDl1⓪+MOVE.L (A0)+,fpop⓪+MOVE.L (A0)+,fpop⓪+MOVE.W D1,fpcmd⓪"!DoDl2 TST.B fpstatlo⓪+BEQ DoDl2⓪+MOVE.L (A0)+,fpop⓪+MOVE.L (A0)+,fpop⓪+MOVE.W #$7400,fpcmd⓪"!DoDl3 MOVE.B fpstatlo,D0⓪+BEQ DoDl3⓪+CMPI.B #8,D0⓪+BNE DoDErr⓪"!GoBack MOVE.L fpop,(A3)+⓪+MOVE.L fpop,(A3)+⓪+MOVE.W fpstat,D0⓪+CMPI.B #2,D0⓪+BNE DoDErr2⓪+RTS⓪"!DoDErr2 SUBQ.L #8,A3⓪"!DoDErr LINK A5,#0⓪+JSR FPUError⓪+UNLK A5⓪+CLR.L (A3)+ ; RETURN 0.0⓪+CLR.L (A3)+⓪"END;⓪ END DoDouble;⓪ *)⓪ ⓪ PROCEDURE @RMUL (a,b:LONGREAL):LONGREAL;⓪ BEGIN⓪"ASSEMBLER⓪"(*$? ~A68881:⓪+LINK A5,#0⓪+MOVEM.L D3-D7,-(A7)⓪+MOVEM.W -16(A3),D0-D7⓪+TST.W D0 ;Op1 = 0 ?⓪+BEQ.L ZERO⓪+TST.W D4 ;Op2 = 0 ?⓪+BEQ.L ZERO⓪+ADD.W D0,D4 ;vorl. Exponent; neues Sign in bit0⓪+BVS.L range ;Ueber/Unterlauf⓪+MOVE.W D4,-(A7)⓪+MOVE.W D3,D4⓪+MULU D7,D4⓪+CLR.W D4⓪+SWAP D4⓪+CLR.W D5⓪+MOVE.W D3,D0⓪+MULU D6,D0⓪+ADD.L D0,D4⓪+BCC L0⓪+ADDQ.W #1,D5⓪"!L0 MOVE.W D2,D0⓪+MULU D7,D0⓪+ADD.L D0,D4⓪+BCC L1⓪+ADDQ.W #1,D5⓪"!L1 MOVE.W D5,D4⓪+SWAP D4⓪+CLR.W D5⓪+MULU D1,D7⓪+ADD.L D7,D4⓪+BCC L2⓪+ADDQ.W #1,D5⓪"!L2 MOVE.W -6(A3),D7⓪+MOVE.W D2,D0⓪+MULU D6,D0⓪+ADD.L D0,D4⓪+BCC L3⓪+ADDQ.W #1,D5⓪"!L3 MULU D7,D3⓪+ADD.L D3,D4⓪+BCC L4⓪+ADDQ.W #1,D5⓪"!L4 MOVE.W D4,D3⓪+MOVE.W D5,D4⓪+SWAP D4⓪+CLR.W D5⓪+MULU D7,D2⓪+ADD.L D2,D4⓪+BCC L5⓪+ADDQ.W #1,D5⓪"!L5 MULU D1,D6⓪+ADD.L D6,D4⓪+BCC L6⓪+ADDQ.W #1,D5⓪"!L6 MOVE.W D4,D6⓪+MOVE.W D5,D4⓪+SWAP D4⓪+MULU D7,D1⓪+⓪+MOVE.W (A7)+,D7⓪+ADD.L D1,D4⓪+BMI ISADJ⓪+ADD.W D3,D3⓪+ADDX.W D6,D6⓪+ADDX.L D4,D4⓪+SUBQ.W #8,D7⓪+BVS ZERO⓪"!ISADJ TST.W D3⓪+BPL NORND⓪+ADDQ.W #1,D6⓪+BCC NORND⓪+ADDQ.L #1,D4⓪+BCC NORND⓪+ADDQ.W #8,D7⓪+BSET #31,D4⓪"!NORND BSET #1,D7 ;markiere als # 0⓪+BCLR #2,D7 ;loesche Schutzbit⓪+SUBA.W #16,A3⓪+MOVE.W D7,(A3)+⓪+MOVE.L D4,(A3)+⓪+MOVE.W D6,(A3)+⓪+MOVEM.L (A7)+,D3-D7⓪+UNLK A5⓪+RTS⓪+⓪"range BMI ovfl ;Summe der Exponenten war so gross,⓪@;dass sie ins negative ueberlief⓪"zero SUBA.W #16,A3⓪+CLR.L (A3)+⓪+CLR.L (A3)+⓪+MOVEM.L (A7)+,D3-D7⓪+UNLK A5⓪+RTS⓪+⓪"ovfl SUBA.W #16,A3⓪+TRAP #6⓪+DC.W -7-$4000 ;overflow⓪+CLR.L (A3)+⓪+CLR.L (A3)+⓪+MOVEM.L (A7)+,D3-D7⓪+UNLK A5⓪"*)⓪"(*$? A68881:⓪+MOVE.W #$5423,D1⓪+JMP DoDouble⓪"*)⓪"END⓪ END @RMUL;⓪ ⓪ ⓪ PROCEDURE @RDIV (a,b:LONGREAL):LONGREAL;⓪ BEGIN⓪"ASSEMBLER⓪"(*$? ~A68881:⓪(LINK A5,#0⓪(MOVEM.L D3-D7,-(A7)⓪(MOVE.W -(A3),D5⓪(MOVE.L -(A3),D4⓪(MOVE.W -(A3),D1⓪(MOVE.W -(A3),D3⓪(MOVE.L -(A3),D2⓪(MOVE.W -(A3),D0⓪(JSR @FPDIV⓪(MOVEM.L (A7)+,D3-D7⓪(UNLK A5⓪"*)⓪"(*$? A68881:⓪'MOVE.W #$5420,D1⓪'JMP DoDouble⓪"*)⓪"END⓪ END @RDIV;⓪ ⓪ PROCEDURE @FPDIV;⓪ BEGIN⓪"ASSEMBLER⓪"(*$? ~A68881:⓪+TST.W D0⓪+BEQ.L ZERO1⓪+TST.W D1⓪+BEQ.L DIVBY0⓪+BCLR #1,D1 ; !TT 01.04.88⓪+SUB.W D1,D0 ;vorl. Exponent und Sign in D0⓪+BVS.L range ;Ueber/Unterlauf⓪+CLR.L D7⓪+MOVEQ #49,D1⓪+BRA L1⓪"!L0 ADD.L D7,D7⓪+ADDX.L D6,D6⓪+ADD.W D3,D3⓪+ADDX.L D2,D2⓪+BCS ONEBIT⓪"!L1 CMP.L D2,D4⓪+BHI ZERBIT⓪+BNE ONEBIT⓪+CMP.W D3,D5⓪+BHI ZERBIT⓪"!ONEBIT SUB.W D5,D3⓪+SUBX.L D4,D2⓪+ADDQ.B #1,D7⓪"!ZERBIT DBF D1,L0⓪+BTST #17,D6⓪+BEQ LESS05⓪+LSR.L #1,D6⓪+ROXR.L #1,D7⓪+ADDQ.W #8,D0⓪+BVS ovfl⓪"!LESS05 LSR.L #1,D6⓪+ROXR.L #1,D7⓪+BCC NORND⓪+ADDQ.L #1,D7⓪+BCC NORND⓪+ADDQ.W #1,D6⓪+BCC NORND⓪+ROXR.W #1,D6⓪+ADDQ.W #8,D0⓪+BVS ovfl⓪"noRnd BSET #1,D0⓪+BCLR #2,D0⓪+MOVE.W D0,(A3)+⓪+MOVE.W D6,(A3)+⓪+MOVE.L D7,(A3)+⓪+RTS⓪+⓪"range BMI ovfl ;Differenz der Exponenten war so gross,⓪@;dass sie ins negative ueberlief⓪"zero1 CLR.L (A3)+⓪+CLR.L (A3)+⓪+RTS⓪+⓪"ovfl TRAP #6⓪+DC.W -7-$4000 ;overflow⓪+BRA errend⓪+⓪"DivBy0 TRAP #6⓪+DC.W -5-$4000⓪"errend: CLR.L (A3)+⓪+CLR.L (A3)+⓪"*)⓪"(*$? A68881:⓪+MOVE.W D0,(A3)+⓪+MOVE.L D2,(A3)+⓪+MOVE.W D3,(A3)+⓪+MOVE.W D1,(A3)+⓪+MOVE.L D4,(A3)+⓪+MOVE.W D5,(A3)+⓪+MOVE.W #$5420,D1⓪+JMP DoDouble⓪"*)⓪"END⓪ END @FPDIV;⓪ ⓪ ⓪ PROCEDURE @RADD (a,b:LONGREAL):LONGREAL;⓪ BEGIN⓪%ASSEMBLER⓪%(*$? ~A68881:⓪+LINK A5,#0⓪+MOVEM.L D3-D7,-(A7)⓪+MOVEM.W -16(A3),D0-D7⓪+SWAP D1⓪+MOVE.W D2,D1 ;höchste 32 Mant.-Stellen (a) in D1⓪+SWAP D5⓪+MOVE.W D6,D5 ;höchste 32 Mant.-Stellen (b) in D5⓪+⓪+ANDI.W #$FFFE,D0⓪+BEQ.L RETN2 ;ein Argument ist 0⓪+ANDI.W #$FFFE,D4⓪+BEQ.L RETN1 ;ein Argument ist 0⓪+CLR.W D6⓪+CMP.W D0,D4⓪+BLT PASST⓪+BNE TAUSCH⓪+CMP.L D1,D5⓪+BCS.L PASST1⓪+BNE TAUSCH⓪+CMP.W D3,D7⓪+BLS.L PASST1⓪"!TAUSCH EXG D0,D4⓪+EXG D1,D5⓪+EXG D3,D7⓪+MOVE.W -16(A3),D2⓪+MOVE.W -8(A3),-16(A3)⓪+MOVE.W D2,-8(A3)⓪"⓪"!PASST SUB.W D4,D0 ;Exp.differenz immer positiv!⓪+LSR #3,D0⓪+BEQ.L PASST1⓪+CMP.W #16,D0⓪+BEQ S16⓪+BHI SGT16⓪+SWAP D7⓪+MOVE.W D5,D7⓪+SWAP D7⓪+LSR.L D0,D5⓪+LSR.L D0,D7⓪+BRA.L DONE⓪"!S16 ADD.W D7,D7⓪+MOVE.W D5,D7⓪+CLR.W D5⓪+SWAP D5⓪+BRA DONE⓪"!SGT16 CMP.W #32,D0⓪+BEQ S32⓪+BHI SGT32⓪+SUB.W #16,D0⓪+LSR.L D0,D5⓪+MOVE.W D5,D7⓪+CLR.W D5⓪+SWAP D5⓪+BRA DONE⓪"!S32 ADD.W D5,D5⓪+SWAP D5⓪+MOVE.W D5,D7⓪+CLR.L D5⓪+BRA DONE⓪"!S48 CLR.L D5⓪+CLR.W D7⓪+MOVEQ #$FF,D6⓪+BRA PASST1⓪"!SGT32 CMP.W #48,D0⓪+BEQ S48⓪+BHI.L RETN1⓪+SUB.W #32,D0⓪+SWAP D5⓪+MOVE.W D5,D7⓪+CLR.L D5⓪+LSR.W D0,D7⓪"!DONE ROXR.W #1,D6⓪"!PASST1 MOVE.W -16(A3),D2 ;Vorzeichen beider Operanden gleich?⓪+MOVE.W -8(A3),D0⓪+ADD.W D2,D0⓪+BTST #0,D0⓪+BNE SUBTR⓪+ADD.W D7,D3⓪+ADDX.L D5,D1⓪+BCC NOFL⓪+ROXR.L #1,D1⓪+ROXR.W #1,D3⓪+BCC INCEX⓪+ADDQ.W #1,D3⓪+BCC INCEX⓪+ADDQ.L #1,D1⓪"!INCEX ADDQ.W #8,D2 ;D2 ist Exp. der betr.mäßig größeren Zahl⓪+BVS.L OVFL⓪"!FERTIG SUBA.W #16,A3⓪+MOVE.W D2,(A3)+⓪+MOVE.L D1,(A3)+⓪+MOVE.W D3,(A3)+⓪+MOVEM.L (A7)+,D3-D7⓪+UNLK A5⓪+RTS⓪+⓪"!NOFL TST.W D6⓪+BPL FERTIG⓪+ADDQ.W #1,D3⓪+BCC FERTIG⓪+ADDQ.L #1,D1⓪+BCC FERTIG⓪+ROXR.L #1,D1⓪+BRA INCEX⓪"⓪"!SUBTR ADD.W D6,D6⓪+SCS D6⓪+SUBX.W D7,D3⓪+SUBX.L D5,D1⓪+TST.L D1⓪+BMI FERTIG⓪+SUBQ.W #8,D2⓪+ADD.W D6,D6⓪+ADDX.W D3,D3⓪+ADDX.L D1,D1⓪+BMI.L fertig⓪+BEQ LGT32 ;Ausloeschung in der Mantisse.. normalisieren⓪+SWAP D1⓪+TST.W D1⓪+BNE LLT16⓪+MOVE.W D3,D1⓪+CLR.W D3⓪+SUB.W #128,D2 ;8 * (16 bit Shift)⓪+BVS zero⓪+TST.L D1⓪+BMI fertig⓪"!L0 SUBQ.W #8,D2⓪+BVS zero⓪+ADD.L D1,D1⓪+BPL L0⓪+BRA fertig⓪"!LLT16 SWAP D1⓪"!L1 SUBQ.W #8,D2⓪+BVS zero⓪+ADD.W D3,D3⓪+ADDX.L D1,D1⓪+BPL L1⓪+BRA fertig⓪"!LGT32 SUB.W #256,D2 ;8 * (32 bit Shift)⓪+BVS zero⓪+MOVE.W D3,D1⓪+BEQ.L ZERO⓪+BMI L3⓪"!L2 SUBQ.W #8,D2⓪+BVS zero⓪+ADD.W D1,D1⓪+BPL L2⓪"!L3 SWAP D1⓪+CLR.W D3⓪+BRA fertig⓪"!ZERO SUBA.W #16,A3⓪+CLR.L (A3)+⓪+CLR.L (A3)+⓪+MOVEM.L (A7)+,D3-D7⓪+UNLK A5⓪+RTS⓪+⓪"!RETN1 SUBA.W #14,A3 ;Exponent stimmt schon⓪+MOVE.L D1,(A3)+ ;Mantisse muß (bei Ausgang 2 hierher)⓪+MOVE.W D3,(A3)+ ; noch getauscht werden!⓪+MOVEM.L (A7)+,D3-D7⓪+UNLK A5⓪+RTS⓪+⓪"!RETN2 MOVE.L -(A3),-8(A3)⓪+MOVE.L -(A3),-8(A3)⓪+MOVEM.L (A7)+,D3-D7⓪+UNLK A5⓪+RTS⓪+⓪"!OVFL TRAP #6⓪+DC.W -7-$4000 ;overflow⓪+BRA ZERO⓪"*)⓪"(*$? A68881:⓪+MOVE.W #$5422,D1⓪+JMP DoDouble⓪"*)⓪"END⓪ END @RADD;⓪ ⓪ PROCEDURE @RSUB (a,b:LONGREAL):LONGREAL;⓪ BEGIN⓪"ASSEMBLER⓪"(*$? ~A68881:⓪$TST.W -8(A3)⓪$BEQ N⓪$BCHG #0,-7(A3)⓪"N JMP @RADD⓪"*)⓪"(*$? A68881:⓪$MOVE.W #$5428,D1⓪$JMP DoDouble⓪"*)⓪"END⓪ END @RSUB;⓪ ⓪ ⓪ BEGIN⓪"has020:= SysInfo.Has020 ();⓪ (*$? A68881:⓪"FPUInit⓪ *)⓪ END Runtime.⓪ ə
- (* $00000A8D$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFEE685A$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34Ç$00000A3FT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000028$FFEE685A$000014A5$00001A0C$00002342$00002CC0$00003461$0000352F$0000372B$00003739$00000A3F$000097A0$00009EAD$00009EB7$0000AC5E$0000AC68¼Çâ*)
-
